home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Voice_Appl1946061142005.psc / Voice Access / VoiceAccess.bas < prev    next >
BASIC Source File  |  2005-10-28  |  9KB  |  232 lines
  1. Attribute VB_Name = "VoiceAccess"
  2. 'Module recycled and modified from my Voice Recognition program:
  3. 'http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=62860&lngWId=1
  4. '
  5. 'Author:      Licar Bogdan (copyright).
  6. '
  7. 'Description: Functions for comparing sounds. It bases on heuristic-statistic
  8. '             methods. Perhaps there are other more efficient methods to to this.
  9. '             I've included 2 other comparing functions, without using them in
  10. '             this project.
  11.  
  12. Option Explicit
  13.  
  14. 'Variables used in more routines
  15. Public Waves() As String, CommandsFld As String
  16.  
  17. Sub LoadWave(ByVal Path As String, values() As Double, Y() As Double)
  18. Dim j As Long, Buff As Long, Yrate As Double
  19.  
  20. Dim Min As Double, Max As Double
  21.  
  22.  
  23. 'Not using other variables just for lack of will:
  24. 'values(0)=the startpoint of the important part
  25. 'values(1)=the endpoint        "    "
  26. 'values(3)=number of low peaks
  27. 'values(4)=number of high peaks
  28.  
  29. On Error Resume Next
  30.         
  31.         'Reads it and registers all values in an array
  32.         j = 44 'Set i To 44, since the wave sample begins at Byte 44.
  33.         Open Path For Random As #1
  34.         Do
  35.             Get #1, j, Buff
  36.             j = j + 1: ReDim Preserve values(j)
  37.             values(j) = Buff
  38.             If Buff > Max Then Max = Buff
  39.             If Buff < Min Then Min = Buff
  40.         Loop Until EOF(1)
  41.         Close #1
  42.  
  43.         'Change the values of the *.wav in cartesian coordinates
  44.         Yrate = (Max - Min) / (500)
  45.         For j = 44 To UBound(values)
  46.             ReDim Preserve Y(j - 43)
  47.             Y(j - 43) = (values(j) / Yrate)
  48.             
  49.             'Count peaks above/below a certain constant
  50.             If Y(j - 43) > (500 / 3.5) Then values(4) = values(4) + 1
  51.             If Y(j - 43) < (-500 / 3.5) Then values(3) = values(3) + 1
  52.         Next j
  53.  
  54.             'Loops for isolating the important part of the wave file
  55.             For j = 1 To UBound(Y) - 1          'The beginning of the "talking" part
  56.                 If (Abs(Y(j) - Y(j + 1))) > 100 Then values(0) = j: Exit For
  57.             Next j
  58.             For j = UBound(Y) To 1 Step -1      'The end of the "talking"
  59.                 If (Abs(Y(j) - Y(j - 1))) > 100 Then values(1) = j: Exit For
  60.             Next j
  61.  
  62. End Sub
  63.  
  64. Function SearchCommand(ByVal Path As String) As String
  65. Dim values1() As Double, values2() As Double, Y1() As Double, Y2() As Double
  66. Dim i As Long, MatchLevel() As Integer, MaxMatchLevel As Integer
  67.     
  68.     GetWaves CommandsFld, Waves
  69.     LoadWave Path, values2, Y2
  70.     ReDim MatchLevel(UBound(Waves))
  71.  
  72.     For i = 1 To UBound(Waves)
  73.         LoadWave CommandsFld & Waves(i), values1, Y1
  74.         
  75.         If AccessGranted(Y1, Y2, values1(0), values1(1), values2(0), _
  76.         values2(1), values1(4), values1(3), values2(4), values2(3), MatchLevel(i)) = True Then SearchCommand = CommandsFld & Waves(i)
  77.         
  78.         'In case more sounds match, it searches for the sound with the greatest
  79.         'MatchLevel. If you find other solutions to this possible problem, let me know.
  80.         If MatchLevel(i) > MaxMatchLevel Then MaxMatchLevel = i
  81.     Next i
  82.  
  83.     If Waves(MaxMatchLevel) = "" Then Exit Function
  84. SearchCommand = CommandsFld & Waves(MaxMatchLevel)
  85. End Function
  86.  
  87. Function AccessGranted(Y1() As Double, Y2() As Double, ByVal StartPoint1 As Long, _
  88. ByVal Endpoint1 As Long, ByVal StartPoint2 As Long, ByVal EndPoint2 As Long, ByVal HighPeaks1, _
  89. ByVal LowPeaks1, ByVal HighPeaks2, ByVal Lowpeaks2, MatchLevel As Integer) As Boolean
  90.  
  91. Dim i As Integer
  92.  
  93. 'Result based on the number of high/low peaks and on statistics of the whole "important part".
  94. 'If you find a better way to verify waves, please let me know.
  95.  
  96. 'On Error Resume Next
  97.  
  98. 'It considers match levels (i.e. a more/less compatible sound than another). More
  99. 'predefined commands could match with the recorded sound, so it verifies which command
  100. 'is more similar to the recorded sound.
  101. AccessGranted = True
  102. Do While AccessGranted = True
  103.     i = i + 1
  104.  
  105.     If Abs(UBound(Y1) - UBound(Y2)) > 250 Then AccessGranted = False: Exit Function
  106.     If (Abs(HighPeaks1 - HighPeaks2) <= 20 - i) And (Abs(LowPeaks1 - Lowpeaks2) <= 20 - i) And _
  107.     (Abs(ArithmeticMean(Y1, StartPoint1, Endpoint1) - ArithmeticMean(Y2, StartPoint2, EndPoint2)) < 8 - i) And _
  108.     (Abs(StandardDeviation(Y1, StartPoint1, Endpoint1) - StandardDeviation(Y2, StartPoint2, EndPoint2)) < 20 - i) Then
  109.  
  110.         MatchLevel = i
  111.         AccessGranted = True
  112.     Else
  113.  
  114.     AccessGranted = False
  115.     End If
  116. Loop
  117.  
  118. End Function
  119.  
  120. Function ArithmeticMean(vals() As Double, ByVal StartPoint As Long, ByVal EndPoint As Long) As Single
  121. Dim i As Long, result As Single
  122. On Error Resume Next
  123.     For i = StartPoint To EndPoint
  124.         result = result + vals(i)
  125.     Next i
  126. ArithmeticMean = result / (EndPoint - StartPoint)
  127. End Function
  128.  
  129. Function StandardDeviation(vals() As Double, ByVal StartPoint As Long, ByVal EndPoint As Long) As Double
  130. Dim i As Long, Am As Single, result As Double
  131. On Error Resume Next
  132. Am = ArithmeticMean(vals(), StartPoint, EndPoint)
  133.     For i = StartPoint To EndPoint
  134.         result = result + ((vals(i) - Am) ^ 2)
  135.     Next i
  136. StandardDeviation = Format(Sqr(result / (EndPoint - StartPoint)), "#.##")
  137. End Function
  138.  
  139. '-------------------------------------------------------------------------------
  140. 'Others
  141.  
  142. Sub GetWaves(ByVal Path As String, Files() As String)
  143. Dim result() As String, filename As String, count As Long
  144.         
  145.         'Returns an array with all the wave files in a folder
  146.         filename = Dir$(Path)
  147.         Do While Len(filename)
  148.             If LCase(Right$(filename, 3)) = "wav" Then
  149.             count = count + 1
  150.             ReDim Preserve result(count)
  151.             result(count) = filename
  152.             End If
  153.             filename = Dir$
  154.         Loop
  155. Files = result
  156. End Sub
  157.  
  158. Function GetFileName(ByVal Path As String, Optional Extension As Boolean = True) As String
  159. Dim i As Integer, str As String, iStart As Integer
  160.     
  161.     If Extension = True Then
  162.         iStart = 1
  163.     ElseIf Extension = False Then
  164.         iStart = Len(Path) - InStr(1, Path, ".") + 2
  165.     End If
  166.     
  167.     For i = iStart To Len(Path)
  168.         str = str & Mid$(StrReverse(Path), i, 1)
  169.         If Mid$(StrReverse(Path), i + 1, 1) = "\" Then str = StrReverse(str): Exit For
  170.     Next i
  171.  
  172. GetFileName = str
  173. End Function
  174.  
  175. '-----------------------------------------------------------------------------------
  176.  
  177. 'If you're not satisfied of the result with AccessGranted, try these 2 functions.
  178. 'I suggest the Statistic_Comparison, since is much more reliable.
  179.  
  180. Function PointToPoint_Comparison(vals1() As Double, vals2() As Double, _
  181. ByVal StartPoint1 As Long, ByVal Endpoint1 As Long, ByVal StartPoint2 _
  182. As Long, ByVal EndPoint2 As Long) As Double
  183.  
  184. Dim j As Long, i As Long, Same As Long, ErrRange As Integer
  185. On Error Resume Next
  186. ErrRange = 10
  187. 'Compares each value of the default sound with the near values of the sound used
  188. 'for the matching process. It leaves a small range of error. With a greater number
  189. 'than 10, there are more chances the sounds to match, but they could also be different,
  190. 'giving a high percentage of matching.
  191. 'This is a not so highly efficient method.
  192.  
  193. For j = 1 To (Endpoint1 - StartPoint1)
  194.     If j = EndPoint2 Then Exit For
  195.  
  196.     For i = -2 To 2
  197.         If (Abs(vals1(StartPoint1 + j) - vals2(StartPoint2 + j + i))) < ErrRange Then Same = Same + 1: Exit For
  198.     Next i
  199.  
  200. Next j
  201.  
  202. PointToPoint_Comparison = Format((Same * 100) / (Endpoint1 - StartPoint1), "#.##")
  203. End Function
  204.  
  205. Function Statistic_Comparison(vals1() As Double, vals2() As Double, ByVal StartPoint1 _
  206. As Long, ByVal Endpoint1 As Long, ByVal StartPoint2 As Long, ByVal EndPoint2 As Long) As Double
  207.  
  208. Dim i As Long, j As Long, Same2 As Long, ErrRange As Integer, v1() As Double, v2() As Double, ArrSize As Integer
  209. ArrSize = 20
  210. ReDim v1(ArrSize): ReDim v2(ArrSize)
  211. On Error Resume Next
  212.  
  213. 'This could be done also by dividing the wave in totally separate parts and analyze them
  214. For j = 1 To (Endpoint1 - StartPoint1)
  215.     If (j + StartPoint2) > EndPoint2 Then Exit For
  216.     
  217.     For i = 1 To ArrSize
  218.         v1(i) = vals1(StartPoint1 + j + i): v2(i) = vals2(StartPoint2 + j + i)
  219.     Next i
  220.     
  221.     If (Abs(ArithmeticMean(v1, LBound(v1), UBound(v1)) - _
  222.         ArithmeticMean(v2, LBound(v2), UBound(v2)))) < 5 And _
  223.         (Abs(StandardDeviation(v1, LBound(v1), UBound(v1)) - _
  224.         StandardDeviation(v2, LBound(v2), UBound(v2)))) < 15 Then Same2 = Same2 + 1
  225.     
  226. Next j
  227. 'I think it's better than the point-to-point technique.
  228. Statistic_Comparison = Format((Same2 * 100) / Round(Endpoint1 - StartPoint1), "#.##")
  229. End Function
  230. '---------------------------------------------------------------------------------
  231. 'School sucks.
  232.